PsL Monthly 1993 December/PSL Monthly Shareware CD-ROM (December 1993).iso/prgmming/dos/pascal/ovrsub.com/OVRPREP.PAS

Pascal/Delphi Source File | 1990-01-05 | 16.6 KB | 549 lines

(*
OVRPREP extracts overlay information from the EXE file of an overlaid Turbo
Pascal 5.x program and appends it to the OVR file.  This information is used
by the OvrSubstitute procedure in the OVRSUB unit.

To use it, first compile the overlaid application to create the EXE and OVR
files and a corresponding MAP file.  OVRPREP must read the first section of the
MAP file (the segment map) to get certain information. It also reads from the
EXE file to get detailed information about the overlays.  This information is
then appended to the OVR file.

Call OVRPREP as follows:

  OVRPREP [Options] ProgName

OVRPREP forces the extensions 'EXE', 'MAP', and 'OVR' onto ProgName to find
the corresponding files.  The only option at present is /Q, which stops OVRPREP
from writing status messages while it works.

Format of data appended to OVR file:

  for each overlaid unit in program
    StatStart : Word;   {Segment address of static dispatcher}
    FileOfs : LongInt;  {Offset of code segment within overlay file}
    CodeSize : Word;    {Number of bytes of actual code for this unit}
    FixupSize : Word;   {Number of bytes of fixup information for this unit}
    EntryPts : Word;    {Number of entry points (procedures and functions) in unit}
    for each EntryPt
      EntryPointCodeOffset : Word;  {Offset of code entry point within unit}
    end for
  end for
  DataSegStart : Word;  {Segment address of Data segment}
  OverBuf : Word;       {Initial size for overlay buffer in paragraphs}
  DataOfs : LongInt;    {Offset of start of OVRPREP data within OVR file}
  Sig : string[6] = 'OVRSUB';  {Signature string}


Written by Ron Schuster
Copyright (c) 1989.  All rights reserved.
May be distributed freely, but not for a profit.

OVRPREP was derived from OVRSIZ, written by Kim Kokkonen,
TurboPower Software, and used with permission of the author.
Copyright (c) 1989, TurboPower Software. All rights reserved.
May be distributed freely, but not for a profit.

Version 1.0, 12/28/89
--------------------
  Initial release.
*)

{$R-,S-,I-,V-,F-,B-}

program OvrPrep;
  {-Appends overlay data to OVR file for use by OVRSUB unit}

uses
  Dos;

{$I OVRSUB.INC}

const
  Version = '1.0';                {Version number}
  MaxUnits = 255;                 {Maximum units in a program}
  OvrInstr : Word = $3FCD;        {INT 3Fh instruction}
  ShowStatus : Boolean = True;    {True to keep status running during operation}
  BufSize = 1024;                 {Size of text I/O buffer}
  NameSize = 15;                  {Maximum reported segment name length}
  Digits : array[0..$F] of Char = '0123456789ABCDEF';

type
  Pathname = String[79];

  ExeHeaderRec =                  {Information describing EXE file}
    record
      Signature : Word;           {EXE file signature}
      LengthRem : Word;           {Number of bytes in last page of EXE image}
      LengthPages : Word;         {Number of 512 byte pages in EXE image}
      NumReloc : Word;            {Number of relocation items}
      HeaderSize : Word;          {Number of paragraphs in EXE header}
      MinHeap : Word;             {Minimum extra paragraphs to allow}
      MaxHeap : Word;             {Paragraphs to keep beyond end of image}
      StackSeg : Word;            {Initial stack seg relative to image base}
      StackPtr : Word;            {Initial SP}
      CheckSum : Word;            {EXE file check sum, not used}
      IpInit : Word;              {Initial IP}
      CodeSeg : Word;             {Initial code seg relative to image base}
      RelocOfs : Word;            {Bytes into EXE for first relocation item}
      OverlayNum : Word;          {Overlay number, not used here}
    end;

  UnitRecord =                    {Description of each unit in program}
    record
      SegClass : Word;            {0 for code, 1 for data, 2 for stack, 3 for heap}
      StatStart : LongInt;        {Start position within EXE image in bytes}
      StatLen : LongInt;          {Length of unit image in bytes}
      Name : String[NameSize];    {Name of the unit}
    end;
  UnitArray = array[1..MaxUnits] of UnitRecord;


var
  Units : UnitArray;              {Describes all segments}
  UnitCount : Word;               {Number of units}
  Iname : Pathname;               {Input EXE file name}
  Mname : Pathname;               {Input MAP file name}
  Oname : Pathname;               {Output OVR file name}
  EXEHeader : ExeHeaderRec;       {Header for input EXE file}
  InF : file;                     {Input EXE file}
  OutF : file;                    {Output OVR file}
  StdErr : Text;                  {Standard error device}
  Buffer : array[1..BufSize] of Char; {Text buffer for map file}
  Ovr : StaticDispatcher;         {Overlay info}

  procedure WriteCopyRight;
    {-Copyright notice in object code and on screen}
  begin
    WriteLn(StdErr, 'OVRPREP, by Kim Kokkonen and Ron Schuster.  Version ', Version);
  end;

  procedure OpenStdErr;
    {-Open standard error device}
  begin
    Assign(StdErr, '');
    Rewrite(StdErr);
    with TextRec(StdErr) do begin
      Handle := 2;
      BufSize := 1;
    end;
  end;

  procedure Error(Msg : String);
    {-Report error and halt}
  begin
    if Msg <> '' then
      WriteLn(Msg);
    Halt(1);
  end;

  procedure InvalidMapError;
    {-Common error}
  begin
    Error('Invalid MAP file format');
  end;

  procedure ErrorExeRead;
    {-Common error}
  begin
    Error('Error reading EXE file');
  end;

  function Long2Str(L : LongInt) : String;
    {-Convert a long/word/integer/byte/shortint to a string}
  var
    S : String;
  begin
    Str(L, S);
    Long2Str := S;
  end;

  function StUpcase(S : String) : String;
    {-Return the uppercase of a string}
  var
    I : Integer;
  begin
    for I := 1 to Length(S) do
      S[I] := Upcase(S[I]);
    StUpcase := S;
  end;

  function TrimLead(S : String) : String;
    {-Return a string with leading white space removed}
  begin
    while (Length(S) > 0) and (S[1] <= ' ') do
      Delete(S, 1, 1);
    TrimLead := S;
  end;

  function Trim(S : String) : String;
    {-Return a string with leading and trailing white space removed}
  begin
    while (Length(S) > 0) and (S[Length(S)] <= ' ') do
      Dec(S[0]);
    while (Length(S) > 0) and (S[1] <= ' ') do
      Delete(S, 1, 1);
    Trim := S;
  end;

  function HasExtension(Name : String; var DotPos : Word) : Boolean;
    {-Return whether and position of extension separator dot in a pathname}
  var
    I : Word;
  begin
    DotPos := 0;
    for I := Length(Name) downto 1 do
      if (Name[I] = '.') and (DotPos = 0) then
        DotPos := I;
    HasExtension := (DotPos > 0) and (Pos('\', Copy(Name, Succ(DotPos), 64)) = 0);
  end;

  function ForceExtension(Name, Ext : String) : String;
    {-Return a pathname with the specified extension attached}
  var
    DotPos : Word;
  begin
    if HasExtension(Name, DotPos) then
      ForceExtension := Copy(Name, 1, DotPos)+Ext
    else
      ForceExtension := Name+'.'+Ext;
  end;

  function BlkRead(var F : file; var Buffer; Size : Word) : Boolean;
    {-Convenient shell around BlockRead}
  var
    BytesRead : Word;
  begin
    BlockRead(F, Buffer, Size, BytesRead);
    BlkRead := (IoResult = 0) and (BytesRead = Size);
  end;

  function FileNewer(FileA, FileB : String) : Boolean;
    {-Return true if FileA is newer than FileB, both known to exist}
  var
    FA : file;
    FB : file;
    TA : LongInt;
    TB : LongInt;
  begin
    Assign(FA, FileA);
    Reset(FA);
    Assign(FB, FileB);
    Reset(FB);
    GetFtime(FA, TA);
    GetFtime(FB, TB);
    Close(FA);
    Close(FB);
    FileNewer := (TA > TB);
  end;

  procedure WriteHelp;
    {-Display help information and halt}
  begin
    WriteLn;
    WriteLn('Usage: OVRPREP [Options] InputName');
    WriteLn;
    WriteLn('  OVRPREP must access:');
    WriteLn('    InputName.EXE - overlaid executable file.');
    WriteLn('    InputName.MAP - symbol file for segment information.');
    WriteLn('    InputName.OVR - overlay file for appending data.');
    WriteLn;
    WriteLn('Options:');
    WriteLn('  /Q    Quiet mode. No status output while processing.');
    Halt(1);
  end;

  function ExistFile(FName : String) : Boolean;
    {-Return true if file exists}
  var
    F : file;
  begin
    Assign(F, FName);
    Reset(F);
    if IoResult = 0 then begin
      ExistFile := True;
      Close(F);
    end else
      ExistFile := False;
  end;

  procedure ValidateInput;
    {-Get working filenames and assure files exist}
  var
    Iroot : Pathname;
    Arg : String;
    I : Integer;
  begin
    {Get parameters}
    Iroot := '';
    I := 1;
    while I <= ParamCount do begin
      Arg := StUpcase(ParamStr(I));
      if (Arg = '/Q') or (Arg = '-Q') then
        ShowStatus := False
      else if Iroot = '' then
        Iroot := Arg
      else
        Error('Too many filenames on command line');
      Inc(I);
    end;
    if (Iroot = '') then
      WriteHelp;

    {Build working filenames}
    Iname := ForceExtension(Iroot, 'EXE');
    Mname := ForceExtension(Iroot, 'MAP');
    Oname := ForceExtension(Iroot, 'OVR');
    {Make sure files are OK}
    if not ExistFile(Iname) then
      Error('EXE file '+Iname+' not found');
    if not ExistFile(Mname) then
      Error('MAP file '+Mname+' not found');
    if not ExistFile(Oname) then
      Error('OVR file '+Oname+' not found');
    if FileNewer(Iname, Mname) then
      Error('MAP file is older than EXE file');
  end;

  function GetLong(var S : String; var L : LongInt) : Boolean;
    {-Parse next longint out of line S}
  var
    Num : String[8];
    Code : Word;
  begin
    S := TrimLead(S);
    Num := '';
    while (Length(S) > 0) and (Pos(S[1], Digits) <> 0) do begin
      Num := Num+S[1];
      Delete(S, 1, 1);
    end;
    if Length(Num) = 0 then begin
      GetLong := False;
      Exit;
    end;
    if (Length(S) > 0) and (Upcase(S[1]) = 'H') then begin
      Num := '$'+Num;
      Delete(S, 1, 1);
    end;
    Val(Num, L, Code);
    GetLong := (Code = 0);
  end;

  function GetName(var S, Name : String) : Boolean;
    {-Parse next alphanumeric name from string s}
  begin
    S := TrimLead(S);
    Name := '';
    while (Length(S) > 0) and (S[1] > ' ') do begin
      if Length(Name) < NameSize then
        Name := Name+S[1];
      Delete(S, 1, 1);
    end;
    GetName := (Name <> '');
  end;

  function NextPara(Bytes : LongInt) : LongInt;
    {-Round up to next paragraph}
  begin
    NextPara := (Bytes+15) and $FFFFFFF0;
  end;

  procedure ParseMapFile(FName : String);
    {-Read and parse the MAP file, guaranteed to exist}
  var
    F : Text;
    S : String;
    SegType : String;
    Tlong : LongInt;
    ParseState : (Unknown, Segments, Done);
  begin

    {Open up the MAP file for reading}
    Assign(F, FName);
    SetTextBuf(F, Buffer, BufSize);
    Reset(F);
    if IoResult <> 0 then
      Error('Error opening '+FName);

    if ShowStatus then
      WriteLn(StdErr, 'Parsing MAP file');

    {Parse the segment description section only}
    UnitCount := 0;
    ParseState := Unknown;
    repeat
      ReadLn(F, S);
      if IoResult <> 0 then
        Error('Error reading '+FName);
      S := StUpcase(Trim(S));
      if S <> '' then
        if Pos('START', S) = 1 then
          ParseState := Segments
        else if Pos('ADDRESS', S) = 1 then
          ParseState := Done
        else if ParseState = Segments then begin
          {Parse the line to get the unit description}
          Inc(UnitCount);
          if UnitCount > MaxUnits then
            Error('Cannot exceed '+Long2Str(MaxUnits)+' segments');
          FillChar(Units[UnitCount], SizeOf(UnitRecord), 0);

          with Units[UnitCount] do begin

            {Get the position and size of the unit in the EXE image}
            if not GetLong(S, StatStart) then
              InvalidMapError;
            {Ignore the end of the segment}
            if not GetLong(S, Tlong) then
              InvalidMapError;
            {Get the length of the segment}
            if not GetLong(S, StatLen) then
              InvalidMapError;

            {Get the name of the segment}
            if not GetName(S, Name) then
              InvalidMapError;

            {Some segments are not really in the EXE file}
            if not GetName(S, SegType) then
              InvalidMapError;
            if SegType = 'CODE' then
              SegClass := 0
            else if SegType = 'DATA' then
              SegClass := 1
            else if SegType = 'STACK' then
              SegClass := 2
            else if SegType = 'HEAP' then
              SegClass := 3
            else
              SegClass := 4;
          end;
        end;
    until (ParseState = Done) or EoF(F);
    Close(F);
  end;

  procedure GetEXEInfo(FName, OName : String);
    {-Open EXE and OVR files, read overlay information from EXE, append to OVR}
  var
    V : Integer;
    I : Integer;
    OverBuf : LongInt;
    OverSiz : LongInt;
    TWord : Word;
  begin
    OverBuf := 0;

    Assign(InF, FName);
    Reset(InF, 1);
    if IoResult <> 0 then
      Error('Error opening EXE file '+FName);

    Assign(OutF, OName);
    Reset(OutF, 1);
    if IoResult <> 0 then
      Error('Error opening OVR file '+OName);

    {Check if OVR file already has data appended}
    Seek(OutF, FileSize(OutF)-SizeOf(Trailer));
    if IoResult <> 0 then
      Error('Error seeking OVR file '+OName);
    if not BlkRead(OutF, Trailer, SizeOf(Trailer)) then
      Error('Error reading OVR file');

    {If no data appended, get file size}
    if Trailer.Sig <> OvrSubSignature then
      Trailer.OldFileSize := FileSize(OutF);

    {Seek to end of file (or former end of file if data is appended)}
    Seek (OutF, Trailer.OldFileSize);
    if IoResult <> 0 then
      Error('Error seeking OVR file '+OName);

    if ShowStatus then
      WriteLn(StdErr, 'Reading EXE header information');

    {Read the existing EXE header}
    if not BlkRead(InF, EXEHeader, SizeOf(ExeHeaderRec)) then
      ErrorExeRead;

    with EXEHeader do begin
      {Assure it's a valid EXE file}
      if Signature <> $5A4D then
        Error('Invalid EXE format for '+FName);

      if ShowStatus then
        WriteLn(StdErr, 'Collecting overlay information');

      for V := UnitCount downto 1 do
        with Units[V], Ovr do
          if (SegClass = 0) and (StatLen > 0) then begin
            {Get to right spot in old EXE file}
            Seek(InF, (LongInt(HeaderSize) shl 4)+StatStart);

            {Read the start of unit into the overlay record}
            if not BlkRead(InF, Ovr, Ofs(Vectors)-Ofs(Ovr)) then
              ErrorExeRead;

            {If it's an overlaid unit, get entry point info and append to OVR}
            if ReturnInt = OvrInstr then begin
              if not BlkRead(InF, Vectors, SizeOf(VectorRec)*EntryPts) then
                ErrorExeRead;
              TWord := StatStart shr 4;
              BlockWrite(OutF, TWord, SizeOf(TWord));
              BlockWrite(OutF, FileOfs, SizeOf(FileOfs));
              BlockWrite(OutF, CodeSize, SizeOf(CodeSize));
              BlockWrite(OutF, FixupSize, SizeOf(FixupSize));
              BlockWrite(OutF, EntryPts, SizeOf(EntryPts));

              for I := 1 to EntryPts do
                BlockWrite (OutF, Vectors[I].CodeOffset, SizeOf(Word));

              OverSiz := NextPara(CodeSize)+NextPara(FixupSize);
              if OverSiz > OverBuf then
                OverBuf := OverSiz;
            end;
          end
    end;

    {Write data about Data segment}
    V := UnitCount;
    while V > 0 do
      with Units[V], Ovr do
        if Name = 'DATA' then begin
          TWord := StatStart shr 4;
          BlockWrite(OutF, TWord, SizeOf(TWord));
          V := 0;
        end
        else
          Dec(V);

    {Write new value for initial overlay buffer size}
    TWord := OverBuf shr 4;
    BlockWrite(OutF, TWord, SizeOf(TWord));

    {Write trailer}
    Trailer.Sig := OvrSubSignature;
    BlockWrite(OutF, Trailer, SizeOf(Trailer));

    Close(InF);
    Close(OutF);
  end;

begin
  {Open standard error device}
  OpenStdErr;

  {Display copyright}
  WriteCopyRight;

  {Get filenames and assure they exist}
  ValidateInput;

  {Parse MAP file to get segment names and locations}
  ParseMapFile(Mname);

  {Read overlay information from EXE file and append to OVR file}
  GetEXEInfo(Iname, Oname);
end.